home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-9.10-netbook-remix-PL.iso / casper / filesystem.squashfs / usr / bin / instmodsh < prev    next >
Encoding:
Text File  |  2009-10-01  |  4.2 KB  |  198 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4. #!/usr/bin/perl -w
  5.  
  6. use strict;
  7. use IO::File;
  8. use ExtUtils::Packlist;
  9. use ExtUtils::Installed;
  10.  
  11. use vars qw($Inst @Modules);
  12.  
  13.  
  14. =head1 NAME
  15.  
  16. instmodsh - A shell to examine installed modules
  17.  
  18. =head1 SYNOPSIS
  19.  
  20.     instmodsh
  21.  
  22. =head1 DESCRIPTION
  23.  
  24. A little interface to ExtUtils::Installed to examine locally* installed modules,
  25. validate your packlists and even create a tarball from an installed module.
  26.  
  27. *On Debian system, B<core> and B<vendor> modules are managed by C<dpkg>.
  28.  
  29. =head1 SEE ALSO
  30.  
  31. ExtUtils::Installed
  32.  
  33. =cut
  34.  
  35.  
  36. my $Module_Help = <<EOF;
  37. Available commands are:
  38.    f [all|prog|doc]   - List installed files of a given type
  39.    d [all|prog|doc]   - List the directories used by a module
  40.    v                  - Validate the .packlist - check for missing files
  41.    t <tarfile>        - Create a tar archive of the module
  42.    h                  - Display module help
  43.    q                  - Quit the module
  44. EOF
  45.  
  46. my %Module_Commands = (
  47.                        f => \&list_installed,
  48.                        d => \&list_directories,
  49.                        v => \&validate_packlist,
  50.                        t => \&create_archive,
  51.                        h => \&module_help,
  52.                       );
  53.  
  54. sub do_module($) {
  55.     my ($module) = @_;
  56.  
  57.     print($Module_Help);
  58.     MODULE_CMD: while (1) {
  59.         print("$module cmd? ");
  60.  
  61.         my $reply = <STDIN>; chomp($reply);
  62.         my($cmd) = $reply =~ /^(\w)\b/;
  63.  
  64.         last if $cmd eq 'q';
  65.  
  66.         if( $Module_Commands{$cmd} ) {
  67.             $Module_Commands{$cmd}->($reply, $module);
  68.         }
  69.         elsif( $cmd eq 'q' ) {
  70.             last MODULE_CMD;
  71.         }
  72.         else {
  73.             module_help();
  74.         }
  75.     }
  76. }
  77.  
  78.  
  79. sub list_installed {
  80.     my($reply, $module) = @_;
  81.  
  82.     my $class = (split(' ', $reply))[1];
  83.     $class = 'all' unless $class;
  84.  
  85.     my @files;
  86.     if (eval { @files = $Inst->files($module, $class); }) {
  87.         print("$class files in $module are:\n   ",
  88.               join("\n   ", @files), "\n");
  89.     }
  90.     else { 
  91.         print($@); 
  92.     }
  93. };
  94.  
  95.  
  96. sub list_directories {
  97.     my($reply, $module) = @_;
  98.  
  99.     my $class = (split(' ', $reply))[1];
  100.     $class = 'all' unless $class;
  101.  
  102.     my @dirs;
  103.     if (eval { @dirs = $Inst->directories($module, $class); }) {
  104.         print("$class directories in $module are:\n   ",
  105.               join("\n   ", @dirs), "\n");
  106.     }
  107.     else { 
  108.         print($@); 
  109.     }
  110. }
  111.  
  112.  
  113. sub create_archive {
  114.     my($reply, $module) = @_;
  115.  
  116.     my $file = (split(' ', $reply))[1];
  117.  
  118.     if( !(defined $file and length $file) ) {
  119.         print "No tar file specified\n";
  120.     }
  121.     elsif( eval { require Archive::Tar } ) {
  122.         Archive::Tar->create_archive($file, 0, $Inst->files($module));
  123.     }
  124.     else {
  125.         my($first, @rest) = $Inst->files($module);
  126.         system('tar', 'cvf', $file, $first);
  127.         for my $f (@rest) {
  128.             system('tar', 'rvf', $file, $f);
  129.         }
  130.         print "Can't use tar\n" if $?;
  131.     }
  132. }
  133.  
  134.  
  135. sub validate_packlist {
  136.     my($reply, $module) = @_;
  137.  
  138.     if (my @missing = $Inst->validate($module)) {
  139.         print("Files missing from $module are:\n   ",
  140.               join("\n   ", @missing), "\n");
  141.     }
  142.     else {
  143.         print("$module has no missing files\n");
  144.     }
  145. }
  146.  
  147. sub module_help {
  148.     print $Module_Help;
  149. }
  150.  
  151.  
  152.  
  153. ##############################################################################
  154.  
  155. sub toplevel()
  156. {
  157. my $help = <<EOF;
  158. Available commands are:
  159.    l            - List all installed modules
  160.    m <module>   - Select a module
  161.    q            - Quit the program
  162. EOF
  163. print($help);
  164. while (1)
  165.    {
  166.    print("cmd? ");
  167.    my $reply = <STDIN>; chomp($reply);
  168.    CASE:
  169.       {
  170.       $reply eq 'l' and do
  171.          {
  172.          print("Installed modules are:\n   ", join("\n   ", @Modules), "\n");
  173.          last CASE;
  174.          };
  175.       $reply =~ /^m\s+/ and do
  176.          {
  177.          do_module((split(' ', $reply))[1]);
  178.          last CASE;
  179.          };
  180.       $reply eq 'q' and do
  181.          {
  182.          exit(0);
  183.          };
  184.       # Default
  185.          print($help);
  186.       }
  187.    }
  188. }
  189.  
  190.  
  191. ###############################################################################
  192.  
  193. $Inst = ExtUtils::Installed->new();
  194. @Modules = $Inst->modules();
  195. toplevel();
  196.  
  197. ###############################################################################
  198.